home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / iconv8_s.arc / H.ARC / RT.H < prev    next >
Encoding:
C/C++ Source or Header  |  1990-03-28  |  33.1 KB  |  1,123 lines
  1. /*
  2.  * Definitions and declarations used throughout the run-time system.
  3.  * These are also used by the linker in constructing data for use by
  4.  * the run-time system.
  5.  */
  6.  
  7. #ifdef StandardC
  8. #include <time.h>
  9. #endif                    /* StandardC */
  10. #include "..\h\cpuconf.h"
  11. #include "..\h\memsize.h"
  12.  
  13. /*
  14.  * Constants that are not likely to vary between implementations.
  15.  */
  16.  
  17. #define BitOffMask (IntBits-1)
  18. #define CsetSize (256/IntBits)    /* number of ints to hold 256 cset
  19.                  *  bits. Use (256/IntBits)+1 if
  20.                  *  256 % IntBits != 0 */
  21. #define MinListSlots        8    /* number of elements in an expansion
  22.                  * list element block  */
  23.  
  24. #define MaxCvtLen       257    /* largest string in conversions; the extra
  25.                  *  one is for a terminating null */
  26. #define MaxReadStr       512    /* largest string to read() in one piece */
  27. #define MaxIn          32767    /* largest number of bytes to read() at once */
  28. #define RandA        1103515245    /* random seed multiplier */
  29. #define RandC          453816694    /* random seed additive constant */
  30. #define RanScale 4.65661286e-10    /* random scale factor = 1/(2^31-1)) */
  31.  
  32. /*
  33.  * File status flags in status field of file blocks.
  34.  */
  35. #define Fs_Read         01    /* read access */
  36. #define Fs_Write     02    /* write access */
  37. #define Fs_Create     04    /* file created on open */
  38. #define Fs_Append    010    /* append mode */
  39. #define Fs_Pipe        020    /* reading/writing on a pipe */
  40.  
  41. #ifdef RecordIO
  42. #define Fs_Record       040     /* record structured file */
  43. #endif                    /* RecordIO */
  44.  
  45. #ifdef StandardLib
  46. #define Fs_Reading     0100     /* last file operation was read */
  47. #define Fs_Writing     0200     /* last file operation was write */
  48. #endif                    /* StandardLib */
  49.  
  50. /*
  51.  * Definitions for interpreter actions.
  52.  */
  53. #define A_Failure    1        /* routine failed */
  54. #define A_Suspension    2        /* routine suspended */
  55. #define A_Return    3        /* routine returned */
  56. #define A_Pret_uw    4        /* interp unwind for Op_Pret */
  57. #define A_Unmark_uw    5        /* interp unwind for Op_Unmark */
  58. #define A_Resumption    6        /* resume generator */
  59. #define A_Pfail_uw    7        /* interp unwind for Op_Pfail */
  60. #define A_Lsusp_uw    8        /* interp unwind for Op_Lsusp */
  61. #define A_Eret_uw    9        /* interp unwind for Op_Eret */
  62. #define A_Coact        10        /* co-expression activated */
  63. #define A_Coret        11        /* co-expression returned */
  64. #define A_Cofail    12        /* co-expression failed */
  65.  
  66. /*
  67.  * Codes returned by invoke to indicate action.
  68.  */
  69. #define I_Builtin    201    /* A built-in routine is to be invoked */
  70. #define I_Fail        202    /* goal-directed evaluation failed */
  71. #define I_Continue    203    /* Continue execution in the interp loop */
  72. #define I_Vararg    204    /* A function with a variable number of args */
  73.  
  74. /*
  75.  * Codes returned by runtime support routines.
  76.  *  Note, some conversion routines also return type codes. Other routines may
  77.  *  return positive values other than return codes. sort() places restrictions
  78.  *  on Less, Equal, and Greater.
  79.  */
  80. #define Less        -1
  81. #define Equal        0
  82. #define Greater        1
  83. #define CvtFail        -2
  84. #define Cvt        -3
  85. #define NoCvt        -4
  86. #define Failure        -5
  87. #define Defaulted    -6
  88. #define Success        -7
  89. #define Error        -8
  90.  
  91. /*
  92.  * Generator types.
  93.  */
  94. #define G_Csusp        1
  95. #define G_Esusp        2
  96. #define G_Psusp        3
  97.  
  98. /*
  99.  * Type codes (descriptors and blocks).
  100.  */
  101. #define T_Null         0    /* null value */
  102. #define T_Integer     1    /* integer */
  103.  
  104. #ifdef LargeInts
  105. #define T_Bignum     2    /* long integer */
  106. #endif                    /* LargeInts */
  107.  
  108. #define T_Real         3    /* real number */
  109. #define T_Cset         4    /* cset */
  110. #define T_File         5    /* file */
  111. #define T_Proc         6    /* procedure */
  112. #define T_List         7    /* list header */
  113. #define T_Table         8    /* table header */
  114. #define T_Record     9    /* record */
  115. #define T_Telem        10    /* table element */
  116. #define T_Lelem        11    /* list element */
  117. #define T_Tvsubs    12    /* substring trapped variable */
  118. #define T_Tvkywd    13    /* keyword trapped variable */
  119. #define T_Tvtbl        14    /* table element trapped variable */
  120. #define T_Set        15    /* set header */
  121. #define T_Selem        16    /* set element */
  122. #define T_Refresh    17    /* refresh block */
  123. #define T_Coexpr    18    /* co-expression */
  124. #define T_External    19    /* external block */
  125. #define T_Slots        20    /* set/table hash slots */
  126.  
  127. #define MaxType        20    /* maximum type number */
  128.  
  129. /*
  130.  * Descriptor types and flags.
  131.  */
  132.  
  133. #define D_Null        (word)(T_Null | F_Nqual)
  134. #define D_Integer    (word)(T_Integer | F_Nqual)
  135.  
  136. #ifdef LargeInts
  137. #define D_Bignum    (word)(T_Bignum | F_Ptr | F_Nqual)
  138. #endif                    /* LargeInts */
  139.  
  140. #define D_Real        (word)(T_Real | F_Ptr | F_Nqual)
  141. #define D_Cset        (word)(T_Cset | F_Ptr | F_Nqual)
  142. #define D_File        (word)(T_File | F_Ptr | F_Nqual)
  143. #define D_Proc        (word)(T_Proc | F_Ptr | F_Nqual)
  144. #define D_List        (word)(T_List | F_Ptr | F_Nqual)
  145. #define D_Table        (word)(T_Table | F_Ptr | F_Nqual)
  146. #define D_Telem        (word)(T_Telem | F_Ptr | F_Nqual)
  147. #define D_Tvsubs    (word)(T_Tvsubs | D_Tvar)
  148. #define D_Tvkywd    (word)(T_Tvkywd | D_Tvar)
  149. #define D_Tvtbl        (word)(T_Tvtbl | D_Tvar)
  150. #define D_Record    (word)(T_Record | F_Ptr | F_Nqual)
  151. #define D_Set        (word)(T_Set | F_Ptr | F_Nqual)
  152. #define D_Refresh    (word)(T_Refresh | F_Ptr | F_Nqual)
  153. #define D_Coexpr    (word)(T_Coexpr | F_Ptr | F_Nqual)
  154. #define D_External    (word)(T_External | F_Ptr | F_Nqual)
  155. #define D_Slots        (word)(T_Slots | F_Ptr | F_Nqual)
  156.  
  157. #define D_Var        (word)(F_Var | F_Nqual | F_Ptr)
  158. #define D_Tvar        (word)(D_Var | F_Tvar)
  159.  
  160. #define TypeMask    63    /* type mask */
  161. #define OffsetMask    (~(D_Tvar)) /* offset mask for variables */
  162.  
  163. /*
  164.  * Run-time data structures.
  165.  */
  166.  
  167. /*
  168.  * Icode consists of operators and arguments.  Operators are small integers,
  169.  *  while arguments may be pointers.  To conserve space in icode files on
  170.  *  computers with 16-bit ints, icode is written by the linker as a mixture
  171.  *  of ints and words (longs).  When an icode file is read in and processed
  172.  *  by the interpreter, it looks like a C array of mixed ints and words.
  173.  *  Accessing this "nonstandard" structure is handled by a union of int and
  174.  *  word pointers and incrementing is done by incrementing the appropriate
  175.  *  member of the union (see the interpreter).  This is a rather dubious
  176.  *  method and certainly not portable.  A better way might be to address
  177.  *  icode with a char *, but the incrementing code might be inefficient
  178.  *  (at a place that experiences a lot of execution activity).
  179.  *
  180.  * For the moment, the dubious coding is isolated under control of the
  181.  *  size of integers.
  182.  */
  183.  
  184. #if IntBits == 16
  185.  
  186. typedef union {
  187.    int *op;
  188.    word *opnd;
  189.    } inst;
  190.  
  191. #else                    /* IntBits == 16 */
  192.  
  193. typedef union {
  194.    word *op;
  195.    word *opnd;
  196.    } inst;
  197.  
  198. #endif                    /* IntBits == 16 */
  199.  
  200. /*
  201.  * Descriptor
  202.  */
  203.  
  204. struct descrip {        /* descriptor */
  205.    word dword;            /*   type field */
  206.    union {
  207.       word integr;        /*   integer value */
  208.       char *sptr;        /*   pointer to character string */
  209.       union block *bptr;    /*   pointer to a block */
  210.       dptr descptr;        /*   pointer to a descriptor */
  211.       } vword;
  212.    };
  213.  
  214. struct sdescrip {
  215.    word length;            /*   length of string */
  216.    char *string;        /*   pointer to string */
  217.    };
  218.  
  219. /*
  220.  * Run-time error numbers and text.
  221.  */
  222. struct errtab {
  223.    int err_no;            /* error number */
  224.    char *errmsg;        /* error message */
  225.    };
  226.  
  227. /*
  228.  * Frame markers
  229.  */
  230. struct ef_marker {        /* expression frame marker */
  231.    inst ef_failure;        /*   failure ipc */
  232.    struct ef_marker *ef_efp;    /*   efp */
  233.    struct gf_marker *ef_gfp;    /*   gfp */
  234.    word ef_ilevel;        /*   ilevel */
  235.    };
  236.  
  237. struct pf_marker {        /* procedure frame marker */
  238.    word pf_nargs;        /*   number of arguments */
  239.    struct pf_marker *pf_pfp;    /*   saved pfp */
  240.    struct ef_marker *pf_efp;    /*   saved efp */
  241.    struct gf_marker *pf_gfp;    /*   saved gfp */
  242.    dptr pf_argp;        /*   saved argp */
  243.    inst pf_ipc;            /*   saved ipc */
  244.    word pf_ilevel;        /*   saved ilevel */
  245.    dptr pf_scan;        /*   saved scanning environment */
  246.    struct descrip pf_locals[1];    /*   descriptors for locals */
  247.    };
  248.  
  249. struct gf_marker {        /* generator frame marker */
  250.    word gf_gentype;        /*   type */
  251.    struct ef_marker *gf_efp;    /*   efp */
  252.    struct gf_marker *gf_gfp;    /*   gfp */
  253.    inst gf_ipc;            /*   ipc */
  254.    struct pf_marker *gf_pfp;    /*   pfp */
  255.    dptr gf_argp;        /*   argp */
  256.    };
  257.  
  258. /*
  259.  * Generator frame marker dummy -- used only for sizing "small"
  260.  *  generator frames where procedure infomation need not be saved.
  261.  *  The first five members here *must* be identical to those for
  262.  *  gf_marker.
  263.  */
  264. struct gf_smallmarker {        /* generator frame marker */
  265.    word gf_gentype;        /*   type */
  266.    struct ef_marker *gf_efp;    /*   efp */
  267.    struct gf_marker *gf_gfp;    /*   gfp */
  268.    inst gf_ipc;            /*   ipc */
  269.    };
  270.  
  271. #ifdef LargeInts
  272.  
  273. typedef unsigned int DIGIT;
  274.  
  275. struct b_bignum {        /* large integer block */
  276.    word title;            /*   T_Bignum */
  277.    word blksize;        /*   block size */
  278.    word msd, lsd;        /*   most and least significant digits */
  279.    int sign;            /*   sign; 0 positive, 1 negative */
  280.    DIGIT digits[1];        /*   digits */
  281.    };
  282.  
  283. #endif                    /* LargeInts */
  284. struct b_real {            /* real block */
  285.    word title;            /*   T_Real */
  286.    double realval;        /*   value */
  287.    };
  288.  
  289. struct b_cset {            /* cset block */
  290.    word title;            /*   T_Cset */
  291.    word size;            /*   size of cset */
  292.    int bits[CsetSize];        /*   array of bits */
  293.    };
  294.  
  295. struct b_file {            /* file block */
  296.    word title;            /*   T_File */
  297.    FILE *fd;            /*   Unix file descriptor */
  298.    word status;            /*   file status */
  299.    struct descrip fname;    /*   file name (string qualifier) */
  300.    };
  301.  
  302. struct b_proc {            /* procedure block */
  303.    word title;            /*   T_Proc */
  304.    word blksize;        /*   size of block */
  305.    union {            /*   entry points for */
  306.       int (*ccode)();        /*     C routines */
  307.       uword ioff;        /*     and icode as offset */
  308.       pointer icode;        /*     and icode as absolute pointer */
  309.       } entryp;
  310.    word nparam;            /*   number of parameters */
  311.    word ndynam;            /*   number of dynamic locals */
  312.    word nstatic;        /*   number of static locals */
  313.    word fstatic;        /*   index (in global table) of first static */
  314.    struct descrip pname;    /*   procedure name (string qualifier) */
  315.    struct descrip lnames[1];    /*   list of local names (qualifiers) */
  316.    };
  317.  
  318. /*
  319.  * b_iproc blocks are used to statically initialize information about
  320.  *  functions.    They are identical to b_proc blocks except for
  321.  *  the pname field which is a sdecrip (simple/string descriptor) instead
  322.  *  of a descrip.  This is done because unions cannot be initialized.
  323.  */
  324.     
  325. struct b_iproc {        /* procedure block */
  326.    word ip_title;        /*   T_Proc */
  327.    word ip_blksize;        /*   size of block */
  328.    int (*ip_entryp)();        /*   entry point (code) */
  329.    word ip_nparam;        /*   number of parameters */
  330.    word ip_ndynam;        /*   number of dynamic locals */
  331.    word ip_nstatic;        /*   number of static locals */
  332.    word ip_fstatic;        /*   index (in global table) of first static */
  333.    struct sdescrip ip_pname;    /*   procedure name (string qualifier) */
  334.    struct descrip ip_lnames[1];    /*   list of local names (qualifiers) */
  335.    };
  336.  
  337. struct b_list {            /* list-header block */
  338.    word title;            /*   T_List */
  339.    word size;            /*   current list size */
  340.    word id;            /*   identification number */
  341.    union block *listhead;    /*   pointer to first list-element block */
  342.    union block *listtail;    /*   pointer to last list-element block */
  343.    };
  344.  
  345. struct b_lelem {        /* list-element block */
  346.    word title;            /*   T_Lelem */
  347.    word blksize;        /*   size of block */
  348.    union block *listprev;    /*   previous list-element block */
  349.    union block *listnext;    /*   next list-element block */
  350.    word nslots;            /*   total number of slots */
  351.    word first;            /*   index of first used slot */
  352.    word nused;            /*   number of used slots */
  353.    struct descrip lslots[1];    /*   array of slots */
  354.    };
  355.  
  356. struct b_slots {        /* set/table hash slots */
  357.    word title;            /*   T_Slots */
  358.    word blksize;        /*   size of block */
  359.    union block *hslots[HSlots];    /*   array of slots (HSlots * 2^n entries) */
  360.    };
  361.  
  362. struct b_table {        /* table-header block */
  363.    word title;            /*   T_Table */
  364.    word size;            /*   current table size */
  365.    word id;            /*   identification number */
  366.    word mask;            /*   mask to get slot num, equals n slots - 1 */
  367.    struct b_slots *hdir[HSegs];    /*   directory of hash slot segments */
  368.    struct descrip defvalue;    /*   default table element value */
  369.    };
  370.  
  371. struct b_telem {        /* table-element block */
  372.    word title;            /*   T_Telem */
  373.    union block *clink;        /*   hash chain link */
  374.    uword hashnum;        /*   for ordering chain */
  375.    struct descrip tref;        /*   entry value */
  376.    struct descrip tval;        /*   assigned value */
  377.    };
  378.  
  379. /*
  380.  * A set header must be a proper prefix of a table header,
  381.  *  and a set element must be a proper prefix of a table element.
  382.  */
  383. struct b_set {            /* set-header block */
  384.    word title;            /*   T_Set */
  385.    word size;            /*   size of the set */
  386.    word id;            /*   identification number */
  387.    word mask;            /*   mask to get slot num, equals n slots - 1 */
  388.    struct b_slots *hdir[HSegs];    /*   directory of hash slot segments */
  389.    };
  390.  
  391. struct b_selem {        /* set-element block */
  392.    word title;            /*   T_Selem */
  393.    union block *clink;        /*   hash chain link */
  394.    uword hashnum;        /*   hash number */
  395.    struct descrip setmem;    /*   the element */
  396.    };
  397.  
  398. struct b_record {        /* record block */
  399.    word title;            /*   T_Record */
  400.    word blksize;        /*   size of block */
  401.    word id;            /*   identification number */
  402.    union block *recdesc;    /*   pointer to record constructor */
  403.    struct descrip fields[1];    /*   fields */
  404.    };
  405.  
  406. /*
  407.  * Alternate uses for procedure block fields, applied to records.
  408.  */
  409. #define nfields    nparam        /* number of fields */
  410. #define recnum nstatic        /* record number */
  411. #define recid fstatic        /* record serial number */
  412. #define recname    pname        /* record name */
  413.  
  414. struct b_tvkywd {        /* keyword trapped variable block */
  415.    word title;            /*   T_Tvkywd */
  416.    int (*putval)();        /*   assignment function for keyword */
  417.    struct descrip kyval;    /*   keyword value */
  418.    struct descrip kyname;    /*   keyword name */
  419.    };
  420.  
  421. struct b_tvsubs {        /* substring trapped variable block */
  422.    word title;            /*   T_Tvsubs */
  423.    word sslen;            /*   length of substring */
  424.    word sspos;            /*   position of substring */
  425.    struct descrip ssvar;    /*   variable that substring is from */
  426.    };
  427.  
  428. struct b_tvtbl {        /* table element trapped variable block */
  429.    word title;            /*   T_Tvtbl */
  430.    union block *clink;        /*   pointer to table header block */
  431.    uword hashnum;        /*   hash number */
  432.    struct descrip tref;        /*   entry value */
  433.    struct descrip tval;        /*   reserved for assigned value */
  434.    };
  435.  
  436. struct b_coexpr {        /* co-expression stack block */
  437.    word title;            /*   T_Coexpr */
  438.    word size;            /*   number of results produced */
  439.    word id;            /*   identification number */
  440.    struct b_coexpr *nextstk;    /*   pointer to next allocated stack */
  441.    struct pf_marker *es_pfp;    /*   current pfp */
  442.    struct ef_marker *es_efp;    /*   efp */
  443.    struct gf_marker *es_gfp;    /*   gfp */
  444.    dptr es_argp;        /*   argp */
  445.    inst es_ipc;            /*   ipc */
  446.    word es_ilevel;        /*   interpreter level */
  447.    word *es_sp;            /*   sp */
  448.    dptr tvalloc;        /*   where to place transmitted value */
  449.    struct descrip freshblk;    /*   refresh block pointer */
  450.    struct astkblk *es_actstk;    /*   pointer to activation stack structure */
  451.    word cstate[CStateSize];    /*   C state information */
  452.    };
  453.  
  454. struct astkblk {          /* co-expression activator-stack block */
  455.    int nactivators;          /*   number of valid activator entries in
  456.                    *    this block */
  457.    struct astkblk *astk_nxt;      /*   next activator block */
  458.    struct actrec {          /*   activator record */
  459.       word acount;          /*     number of calls by this activator */
  460.       struct b_coexpr *activator; /*     the activator itself */
  461.       } arec[ActStkBlkEnts];
  462.    };
  463.  
  464. struct b_refresh {        /* co-expression block */
  465.    word title;            /*   T_Refresh */
  466.    word blksize;        /*   size of block */
  467.    word *ep;            /*   entry point */
  468.    word numlocals;        /*   number of locals */
  469.    struct pf_marker pfmkr;    /*   marker for enclosing procedure */
  470.    struct descrip elems[1];    /*   arguments and locals, including Arg0 */
  471.    };
  472.  
  473. struct b_external {        /* external block */
  474.    word title;            /*   T_External */
  475.    word blksize;        /*   size of block */
  476.    word descoff;        /*   offset to first descriptor */
  477.    word exdata[1];        /*   words of external data */
  478.    };
  479.  
  480. union block {            /* general block */
  481.  
  482. #ifdef LargeInts
  483.    struct b_bignum bignumblk;
  484. #endif                    /* LargeInts */
  485.  
  486.    struct b_real realblk;
  487.    struct b_cset cset;
  488.    struct b_file file;
  489.    struct b_proc proc;
  490.    struct b_list list;
  491.    struct b_lelem lelem;
  492.    struct b_table table;
  493.    struct b_telem telem;
  494.    struct b_set set;
  495.    struct b_selem selem;
  496.    struct b_record record;
  497.    struct b_tvkywd tvkywd;
  498.    struct b_tvsubs tvsubs;
  499.    struct b_tvtbl tvtbl;
  500.    struct b_refresh refresh;
  501.    struct b_coexpr coexpr;
  502.    struct b_external externl;
  503.    struct b_slots slots;
  504.    };
  505.  
  506. /*
  507.  * Declarations for entries in tables associating icode location with
  508.  *  source program location.
  509.  */
  510. struct ipc_fname {
  511.    word ipc;        /* offset of instruction into code region */
  512.    word fname;        /* offset of file name into string region */
  513.    };
  514.  
  515. struct ipc_line {
  516.    word ipc;        /* offset of instruction into code region */
  517.    int line;        /* line number */
  518.    };
  519.  
  520. /*
  521.  * External declarations.
  522.  */
  523.  
  524. extern char *code;        /* start of icode */
  525.  
  526. extern word stksize;        /* size of co-expression stacks in words */
  527. extern word *stackend;        /* end of evaluation stack */
  528. extern struct b_coexpr *stklist;/* base of co-expression stack list */
  529.  
  530. extern word mstksize;        /* size of main stack in words */
  531.  
  532. extern char *statbase;        /* start of static space */
  533. extern char *statend;        /* end of static space */
  534. extern char *statfree;        /* static space free list header */
  535. extern word statsize;        /* size of static space */
  536. extern word statincr;        /* size of increment for static space */
  537.  
  538. extern word ssize;        /* size of string space (bytes) */
  539. extern char *strbase;        /* start of string space */
  540. extern char *strend;        /* end of string space */
  541. extern char *strfree;        /* string space free pointer */
  542.  
  543. extern word abrsize;        /* size of allocated block region (words) */
  544. extern char *blkbase;        /* base of allocated block region */
  545. extern char *blkend;        /* maximum address in allocated block region */
  546. extern char *blkfree;        /* first free location in allocated block region */
  547.  
  548. extern int bsizes[];        /* sizes of blocks */
  549. extern int firstd[];        /* offset (words) of first descrip. */
  550. extern char *blkname[];        /* print names for block types. */
  551. extern uword segsize[];        /* size of hash bucket segment */
  552.  
  553.  
  554. extern struct b_tvkywd tvky_err;    /* trapped variable for &error */
  555. extern struct b_tvkywd tvky_pos;    /* trapped variable for &pos */
  556. extern struct b_tvkywd tvky_ran;    /* trapped variable for &random */
  557. extern struct b_tvkywd tvky_sub;    /* trapped variable for &subject */
  558. extern struct b_tvkywd tvky_trc;    /* trapped variable for &trace */
  559.  
  560.  
  561. #define k_error tvky_err.kyval.vword.integr    /* value of &error */
  562. #define k_pos tvky_pos.kyval.vword.integr    /* value of &pos */
  563. #define k_random tvky_ran.kyval.vword.integr    /* value of &random */
  564. #define k_subject tvky_sub.kyval        /* value of &subject */
  565. #define k_trace tvky_trc.kyval.vword.integr    /* value of &trace */
  566.  
  567. extern struct b_cset k_ascii;        /* value of &ascii */
  568. extern struct b_cset k_cset;        /* value of &cset */
  569. extern struct b_cset k_digits;        /* value of &lcase */
  570. extern struct b_file k_errout;        /* value of &errout */
  571. extern struct b_file k_input;        /* value of &input */
  572. extern struct b_cset k_lcase;        /* value of &lcase */
  573. extern struct b_cset k_letters;        /* value of &letters */
  574. extern int k_level;            /* value of &level */
  575. extern char *k_errortext;        /* value of &errortext */
  576. extern int k_errornumber;        /* value of &errornumber */
  577. extern struct descrip k_errorvalue;    /* value of &errorvalue */
  578. extern struct descrip k_main;        /* value of &main */
  579. extern struct descrip k_current;    /* ¤t */
  580. extern struct b_file k_output;        /* value of &output */
  581. extern struct b_cset k_ucase;        /* value of &ucase */
  582.  
  583. #ifdef StandardLib
  584. extern clock_t starttime;        /* start time in milliseconds */
  585. #else                    /* StandardLib */
  586. extern long starttime;            /* start time in milliseconds */
  587. #endif                    /* StandardLib */
  588.  
  589. extern struct descrip nulldesc;        /* null value */
  590. extern struct descrip zerodesc;        /* zero */
  591. extern struct descrip onedesc;        /* one */
  592. extern struct descrip emptystr;        /* empty string */
  593. extern struct descrip blank;        /* blank */
  594. extern struct descrip letr;        /* letter "r" */
  595. extern struct descrip maps2;        /* second argument to map() */
  596. extern struct descrip maps3;        /* third argument to map() */
  597. extern struct descrip input;        /* &input */
  598. extern struct descrip errout;        /* &errout */
  599. extern struct descrip lcase;        /* lowercase string */
  600. extern struct descrip ucase;        /* uppercase string */
  601.  
  602. extern int ntended;        /* number of active tended descriptors */
  603. extern struct descrip tended[];    /* tended descriptors */
  604.  
  605. extern word *sp;        /* interpreter stack pointer */
  606. extern word *stack;        /* interpreter stack base */
  607. extern struct pf_marker *pfp;    /* procedure frame pointer */
  608. extern struct ef_marker *efp;    /* expression frame pointer */
  609. extern struct gf_marker *gfp;    /* generator frame pointer */
  610. extern inst ipc;        /* interpreter program counter */
  611. extern dptr argp;        /* argument pointer */
  612. extern int ilevel;        /* interpreter level */
  613.  
  614. #ifdef ExecImages
  615. extern int dumped;        /* the interpreter has been dumped */
  616. #endif                    /* ExecImages */
  617.  
  618. #if EBCDIC == 2
  619. extern char ToEBCDIC[], FromEBCDIC[]; /* ASCII<->EBCDIC maps */
  620. #define ToAscii(e) (FromEBCDIC[e])
  621. #define FromAscii(e) (ToEBCDIC[e])
  622. #else                    /* EBCDIC == 2 */
  623. #define ToAscii(e) (e)
  624. #define FromAscii(e) (e)
  625. #endif                    /* EBCDIC == 2 */
  626.  
  627.  
  628. /*
  629.  * Evaluation stack overflow margin
  630.  */
  631.  
  632. #define PerilDelta 100
  633.  
  634. /*
  635.  * Macro definitions related to descriptors.
  636.  */
  637.  
  638. /*
  639.  * The following code is operating-system dependent [@rt.01].  Define
  640.  *  PushAval for computers that store longs and pointers differently.
  641.  */
  642.  
  643. #if PORT
  644. #define PushAVal(x) PushVal(x)
  645. Deliberate Syntax Error
  646. #endif                    /* PORT */
  647.  
  648. #if AMIGA || ATARI_ST || HIGHC_386 || MACINTOSH || MVS || UNIX || VM || VMS
  649. #define PushAVal(x) PushVal(x)
  650. #endif                    /* AMIGA || ATARI_ST || HIGHC_386 ... */
  651.  
  652. #if MSDOS || OS2
  653. static union {
  654.        pointer stkadr;
  655.        word stkint;
  656.    } stkword;
  657.  
  658. #define PushAVal(x)  {sp++; \
  659.             stkword.stkadr = (char *)(x); \
  660.             *sp = stkword.stkint;}
  661. #endif                    /* MSDOS || OS2 */
  662.  
  663. /*
  664.  * End of operating-system specific code.
  665.  */
  666.  
  667. /*
  668.  * Pointer to block.
  669.  */
  670. #define BlkLoc(d)    ((d).vword.bptr)
  671.  
  672. /*
  673.  * Check for null-valued descriptor.
  674.  */
  675. #define ChkNull(d)    ((d).dword==D_Null)
  676.  
  677. /*
  678.  * Dereference descriptor.
  679.  */
  680. #define DeRef(d)    (Var(d) ? deref(&d) : Success)
  681.  
  682. /*
  683.  * Check for equivalent descriptors.
  684.  */
  685. #define EqlDesc(d1,d2)    ((d1).dword == (d2).dword && BlkLoc(d1) == BlkLoc(d2))
  686.  
  687. /*
  688.  * Integer value.
  689.  */
  690. #define IntVal(d)    ((d).vword.integr)
  691.  
  692. /*
  693.  * Offset from top of block to value of variable.
  694.  */
  695. #define Offset(d)    ((d).dword & OffsetMask)
  696.  
  697. /*
  698.  * Check for pointer.
  699.  */
  700. #define Pointer(d)    ((d).dword & F_Ptr)
  701.  
  702. /*
  703.  * Check for qualifier.
  704.  */
  705. #define Qual(d)        (!((d).dword & F_Nqual))
  706.  
  707. /*
  708.  * Length of string.
  709.  */
  710. #define StrLen(q)    ((q).dword)
  711.  
  712. /*
  713.  * Location of first character of string.
  714.  */
  715. #define StrLoc(q)    ((q).vword.sptr)
  716.  
  717. /*
  718.  * Check for trapped variable.
  719.  */
  720. #define Tvar(d)        ((d).dword & F_Tvar)
  721.  
  722. /*
  723.  * Location of trapped-variable block.
  724.  */
  725. #define TvarLoc(d)    ((d).vword.bptr)
  726.  
  727. /*
  728.  * Type of descriptor.
  729.  */
  730. #define Type(d)        (int)((d).dword & TypeMask)
  731.  
  732. /*
  733.  * Check for variable.
  734.  */
  735. #define Var(d)        ((d).dword & F_Var)
  736.  
  737. /*
  738.  * Location of the value of a variable.
  739.  */
  740. #define VarLoc(d)    ((d).vword.descptr)
  741.  
  742. /*
  743.  *  Important note:  The code that follows is not strictly legal C.
  744.  *   It tests to see if pointer p2 is between p1 and p3. This may
  745.  *   involve the comparison of pointers in different arrays, which
  746.  *   is not well-defined.  The casts of these pointers to unsigned "words"
  747.  *   (longs or ints, depending) works with all C compilers and architectures
  748.  *   on which Icon has been implemented.  However, it is possible it will
  749.  *   not work on some system.  If it doesn't, there may be a "false
  750.  *   positive" test, which is likely to cause a memory violation or a
  751.  *   loop. It is not practical to implement Icon on a system on which this
  752.  *   happens.
  753.  */
  754.  
  755. #define InRange(p1,p2,p3) ((uword)(p2) >= (uword)(p1) && (uword)(p2) < (uword)(p3))
  756.  
  757. /*
  758.  * Macros for pushing values on the interpreter stack.
  759.  */
  760.  
  761. /*
  762.  * Push descriptor.
  763.  */
  764. #define PushDesc(d)    {*++sp = ((d).dword); sp++;*sp =((d).vword.integr);}
  765.  
  766. /*
  767.  * Push null-valued descriptor.
  768.  */
  769. #define PushNull    {*++sp = D_Null; sp++; *sp = 0;}
  770.  
  771. /*
  772.  * Push word.
  773.  */
  774. #define PushVal(v)    {*++sp = (word)(v);}
  775.  
  776. /*
  777.  * Macros related to function and operator definition.
  778.  */
  779.  
  780. /*
  781.  * Procedure block for a function.
  782.  */
  783.  
  784. #define FncBlock(f,nargs,deref) \
  785.     struct b_iproc Cat(B,f) = {\
  786.     T_Proc,\
  787.     Vsizeof(struct b_proc),\
  788.     Cat(X,f),\
  789.     nargs,\
  790.     -1,\
  791.     deref, 0,\
  792.     {sizeof(Lit(f))-1,Lit(f)}};
  793.  
  794.  
  795. /*
  796.  * Function declaration for variable number of arguments.
  797.  */
  798. #define FncDcl(nm,n) FncBlock(nm,n,0) Cat(X,nm)(cargp)  register dptr cargp;
  799.  
  800. /*
  801.  * Function declaration for variable number of arguments.
  802.  */
  803. #define FncDclV(nm) FncBlock(nm,-1,0) Cat(X,nm)(nargs,cargp) register dptr cargp;
  804.  
  805. /*
  806.  * Function declaration without dereferenced arguments.
  807.  */
  808. #define FncNDcl(nm,n) FncBlock(nm,n,-1) Cat(X,nm)(cargp)  register dptr cargp;
  809.  
  810. /*
  811.  * Function declaration for variable number of arguments.
  812.  */
  813. #define FncNDclV(nm) FncBlock(nm,-1,-1) Cat(X,nm)(nargs,cargp) register dptr cargp;
  814.  
  815. /*
  816.  * Declaration for library routine.
  817.  */
  818. #define LibDcl(nm,n,pn) OpBlock(nm,n,pn,0) Cat(O,nm)(nargs,cargp) \
  819.    register dptr cargp;
  820. /*
  821.  * Procedure block for an operator.
  822.  */
  823. #define OpBlock(f,nargs,sname,realargs)\
  824.     struct b_iproc Cat(B,f) = {\
  825.     T_Proc,\
  826.     Vsizeof(struct b_proc),\
  827.     Cat(O,f),\
  828.     nargs,\
  829.     -1,\
  830.     realargs,\
  831.     0,\
  832.     {sizeof(sname)-1,sname}};
  833.  
  834. /*
  835.  * Operator declaration.
  836.  */
  837. #define OpDcl(nm,n,pn) OpBlock(nm,n,pn,0) Cat(O,nm)(cargp) register dptr cargp;
  838.  
  839. /*
  840.  * Agent routine declaration.
  841.  */
  842. #define AgtDcl(nm) Cat(A,nm)(cargp) register dptr cargp;
  843.  
  844. #ifdef StrInvoke
  845. /*
  846.  * Structure for mapping string names of procedures to block addresses.
  847.  */
  848. struct pstrnm {
  849.    char *pstrep;
  850.    struct b_proc *pblock;
  851.    };
  852.  
  853. #endif                    /* StrInvoke */
  854. /*
  855.  * Character translations.
  856.  */
  857. #if EBCDIC == 2
  858. extern char ToEBCDIC[], FromEBCDIC[]; /* ASCII<->EBCDIC maps */
  859. #define ToAscii(e) (FromEBCDIC[e])
  860. #define FromAscii(e) (ToEBCDIC[e])
  861. #else                    /* EBCDIC == 2 */
  862. #define ToAscii(e) (e)
  863. #define FromAscii(e) (e)
  864. #endif                    /* EBCDIC == 2 */
  865.  
  866. /*
  867.  * Macros to access Icon arguments in C functions.
  868.  */
  869.  
  870. /*
  871.  * n-th argument.
  872.  */
  873. #define Arg(n)         (cargp[n])
  874.  
  875. /*
  876.  * Type field of n-th argument.
  877.  */
  878. #define ArgType(n)    (cargp[n].dword)
  879.  
  880. /*
  881.  * Value field of n-th argument.
  882.  */
  883. #define ArgVal(n)    (cargp[n].vword.integr)
  884.  
  885. /*
  886.  * Specific arguments.
  887.  */
  888. #define Arg0    (cargp[0])
  889. #define Arg1    (cargp[1])
  890. #define Arg2    (cargp[2])
  891. #define Arg3    (cargp[3])
  892. #define Arg4    (cargp[4])
  893. #define Arg5    (cargp[5])
  894. #define Arg6    (cargp[6])
  895.  
  896. /*
  897.  * Code expansions for exits from C code for top-level routines.
  898.  */
  899. #define Fail        return A_Failure
  900. #define Return        return A_Return
  901.  
  902. #define Suspend  { \
  903.    int rc; \
  904.    if ((rc = interp(G_Csusp,cargp)) != A_Resumption) \
  905.       return rc;} 
  906.  
  907. #define Forward(agent) return Cat(A,agent)(cargp)
  908.  
  909. /*
  910.  * Miscellaneous macro definitions.
  911.  */
  912.  
  913. /*
  914.  * Error exit from non top-level routines.
  915.  */
  916. #define RetError(n,v) {\
  917.    k_errornumber = n;\
  918.    k_errortext = "";\
  919.    k_errorvalue = v;\
  920.    return Error;}
  921.  
  922. /*
  923.  * Get floating-point number from real block.
  924.  */
  925. #ifdef Double
  926. #define GetReal(dp,res)    { \
  927.                          word *rp, *rq; \
  928.                          rp = (word *) &(res); \
  929.                          rq = (word *) &(BlkLoc(*dp)->realblk.realval); \
  930.                          *rp++ = *rq++; \
  931.                          *rp = *rq;} 
  932. #else                    /* Double */
  933. #define GetReal(dp,res)    res = BlkLoc(*dp)->realblk.realval
  934. #endif                    /* Double */
  935.  
  936. /*
  937.  * Absolute value of x (word).
  938.  */
  939. #if SASC
  940. #define Abs(x) __builtin_abs(x)
  941. #else                    /* SASC */
  942. #define Abs(x) (((x) < 0) ? (-(x)) : (x))
  943. #endif                    /* SASC */
  944.  
  945. /*
  946.  * Maximum of x and y.
  947.  */
  948. #define Max(x,y)        ((x)>(y)?(x):(y))
  949. #if SASC
  950. #undef Max
  951. #define Max(x,y)     __builtin_max(x,y)
  952. #endif                    /* SASC */
  953.  
  954. /*
  955.  * Minimum of x and y.
  956.  */
  957. #define Min(x,y)        ((x)<(y)?(x):(y))
  958. #if SASC
  959. #undef Min
  960. #define Min(x,y)     __builtin_min(x,y)
  961. #endif                    /* SASC */
  962.  
  963. /*
  964.  * Some C compilers take '\n' and '\r' to be the same, so the
  965.  *  following definitions are used.
  966.  */
  967. #if EBCDIC
  968. /*
  969.  * Note that, in EBCDIC, "line feed" and "new line" are distinct
  970.  *  characters.  Icon's use of "line feed" is really "new line" in
  971.  *  C terms.
  972.  */
  973. #define LineFeed '\n' /* if really "line feed", that's 37 */
  974. #define CarriageReturn '\r'
  975. #else                    /* EBCDIC */
  976. #define LineFeed  10
  977. #define CarriageReturn 13
  978. #endif                    /* EBCDIC */
  979.  
  980. /*
  981.  * Construct an integer descriptor.
  982.  */
  983. #define MakeInt(i,dp)    { \
  984.                       (dp)->dword = D_Integer; \
  985.                          IntVal(*dp) = (word)(i);}
  986.  
  987. /*
  988.  * Check whether a set or table needs resizing.
  989.  */
  990. #define SP(p) ((struct b_set *)p)
  991. #define TooCrowded(p) \
  992.    ((SP(p)->size > MaxHLoad*(SP(p)->mask+1)) && (SP(p)->hdir[HSegs-1] == NULL))
  993. #define TooSparse(p) \
  994.    ((SP(p)->hdir[1] != NULL) && (SP(p)->size < MinHLoad*(SP(p)->mask+1)))
  995.  
  996. /*
  997.  * RunErr encapsulates a call to the function runerr, followed
  998.  *  by Fail.  The idea is to avoid the problem of calling
  999.  *  runerr directly and forgetting that it may actually return.
  1000.  */
  1001.  
  1002. #define RunErr(n,dp) {\
  1003.    runerr((int)n,dp);\
  1004.    Fail;\
  1005.    }
  1006.  
  1007. /*
  1008.  *  Vsizeof is for use with variable-sized (i.e., indefinite)
  1009.  *   structures containing an array of descriptors declared of size 1
  1010.  *   to avoid compiler warnings associated with 0-sized arrays.
  1011.  */
  1012.  
  1013. #define Vsizeof(s)    (sizeof(s) - sizeof(struct descrip))
  1014.  
  1015. /*
  1016.  * Offset in word of cset bit.
  1017.  */
  1018. #define CsetOff(b)    ((b) & BitOffMask) 
  1019. /*
  1020.  * Address of word of cset bit.
  1021.  */
  1022. #define CsetPtr(b,c)    ((c) + (((b)&0377) >> LogIntBits)) 
  1023. /*
  1024.  * Set bit b in cset c.
  1025.  */
  1026. #define Setb(b,c)    (*CsetPtr(b,c) |= (01 << CsetOff(b))) 
  1027. /*
  1028.  * Test bit b in cset c.
  1029.  */
  1030. #define Testb(b,c)    ((*CsetPtr(b,c) >> CsetOff(b)) & 01) 
  1031.  
  1032. /*
  1033.  * Handy sizeof macros:
  1034.  *
  1035.  *  Wsizeof(x)    -- Size of x in words.
  1036.  *  Vwsizeof(x) -- Size of x in words, minus the size of a descriptor.    Used
  1037.  *   when structures have a potentially null list of descriptors
  1038.  *   at their end.
  1039.  */
  1040. #define Wsizeof(x)    ((sizeof(x) + sizeof(word) - 1) / sizeof(word))
  1041. #define Vwsizeof(x)    ((sizeof(x) - sizeof(struct descrip) +sizeof(word) - 1)\
  1042.                / sizeof(word))
  1043. /*
  1044.  * Definitions and declarations used for storage management.
  1045.  */
  1046.  
  1047. #define F_Mark        0100000     /* bit for marking blocks */
  1048.  
  1049. #define Static  1            /* collection is for static region */
  1050. #define Strings    2            /* collection is for strings */
  1051. #define Blocks    3            /* collection is for blocks */
  1052.  
  1053. /*
  1054.  * External definitions.
  1055.  */
  1056.  
  1057. extern char *currend;            /* current end of memory region */
  1058. extern uword blkneed;            /* stated need for block space */
  1059. extern uword strneed;            /* stated need for string space */
  1060. extern uword statneed;
  1061. extern dptr globals;             /* start of global variables */
  1062. extern dptr eglobals;            /* end of global variables */
  1063. extern dptr gnames;            /* start of global variable names */
  1064. extern dptr egnames;             /* end of global variable names */
  1065. extern dptr statics;             /* start of static variables */
  1066. extern dptr estatics;            /* end of static variables */
  1067.  
  1068. extern dptr *quallist;            /* start of qualifier list */
  1069. extern word qualsize;
  1070.  
  1071. /*
  1072.  * Get type of block pointed at by x.
  1073.  */
  1074. #define BlkType(x)   (*(word *)x)
  1075.  
  1076. /*
  1077.  * BlkSize(x) takes the block pointed to by x and if the size of
  1078.  *  the block as indicated by bsizes[] is nonzero it returns the
  1079.  *  indicated size; otherwise it returns the second word in the
  1080.  *  block contains the size.
  1081.  */
  1082. #define BlkSize(x) (bsizes[*(word *)x & ~F_Mark] ? \
  1083.              bsizes[*(word *)x & ~F_Mark] : *((word *)x + 1))
  1084.  
  1085. /*
  1086.  * If memory monitoring is not enabled, redefine function calls
  1087.  * to do nothing.
  1088.  */
  1089. #ifndef MemMon
  1090. #define MMAlc(n,t)
  1091. #define MMBGC(r)
  1092. #define MMEGC()
  1093. #define MMMark(b,t)
  1094. #define MMShow(d,s)
  1095. #define MMStat(a,l,c)
  1096. #define MMStr(n)
  1097. #define MMSMark(a,n)
  1098. #endif                    /* MemMon */
  1099.  
  1100. #ifndef FixedRegions
  1101.  
  1102. /*
  1103.  * Information used with Icon's allocation routines with expandable-regions
  1104.  *  memory management.
  1105.  */
  1106.  
  1107. typedef int ALIGN;        /* pick most stringent type for alignment */
  1108.  
  1109. union bhead {            /* header of free block */
  1110.    struct {
  1111.       union bhead *ptr;     /* pointer to next free block */
  1112.       uword bsize;        /* free block size */
  1113.       } s;
  1114.    ALIGN x;            /* force block alignment */
  1115.    };
  1116.  
  1117. typedef union bhead HEADER;
  1118. #define NALLOC 64        /* units to request at one time */
  1119.  
  1120. #define FREEMAGIC 0x807F    /* magic flag for free blocks (MemMon only) */
  1121.  
  1122. #endif                    /* FixedRegions */
  1123.